﻿'// Copyright 2004-2007 Castle Project - http://www.castleproject.org/
'// 
'// Licensed under the Apache License, Version 2.0 (the "License");
'// you may not use this file except in compliance with the License.
'// You may obtain a copy of the License at
'// 
'//     http://www.apache.org/licenses/LICENSE-2.0
'// 
'// Unless required by applicable law or agreed to in writing, software
'// distributed under the License is distributed on an "AS IS" BASIS,
'// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
'// See the License for the specific language governing permissions and
'// limitations under the License.

'NOTE: I swiped and translated this class from the Castle Project, for the specific purpose of marking dynamcially
'   created types as serializable - I dislike using other people's work but I had no idea dynamic attribution was so involved

Imports System.Reflection
Imports System.Reflection.Emit

Friend Class CustomAttributeUtil
    Public Shared Function CreateCustomAttribute(ByVal attribute As Attribute) As CustomAttributeBuilder
        Dim attType As Type = attribute.[GetType]()
        Dim ci As ConstructorInfo = Nothing
        Dim ctorArgs As Object() = GetConstructorAndArgs(attType, attribute, ci)
        Dim properties As PropertyInfo() = Nothing
        Dim propertyValues As Object() = GetPropertyValues(attType, properties, attribute)
        Dim fields As FieldInfo() = Nothing
        Dim fieldValues As Object() = GetFieldValues(attType, fields, attribute)
        ' here we are going to try to initialize the attribute with the collected arguments 
        ' if we are good (created successfuly) we return it, otherwise, it is ignored. 
        Try
            Activator.CreateInstance(attType, ctorArgs)
            Return New CustomAttributeBuilder(ci, ctorArgs, properties, propertyValues, fields, fieldValues)
        Catch
            ' there is no real way to log a warning here... 
            Trace.WriteLine("Dynamic Proxy 2: Unable to find matching parameters for replicating attribute " & attType.FullName & ".")
            Return Nothing
        End Try
    End Function

    Private Shared Function GetConstructorAndArgs(ByVal attType As Type, ByVal attribute As Attribute, ByRef ci As ConstructorInfo) As Object()
        Dim ctorArgs As Object() = New Object(-1) {}
        ci = attType.GetConstructors()(0)
        Dim constructorParams As ParameterInfo() = ci.GetParameters()
        If constructorParams.Length <> 0 Then
            ctorArgs = New Object(constructorParams.Length - 1) {}
            InitializeConstructorArgs(attType, attribute, ctorArgs, constructorParams)
        End If
        Return ctorArgs
    End Function

    Private Shared Function GetPropertyValues(ByVal attType As Type, ByRef properties As PropertyInfo(), ByVal attribute As Attribute) As Object()
        Dim selectedProps As New ArrayList()
        For Each pi As PropertyInfo In attType.GetProperties(BindingFlags.Instance Or BindingFlags.[Public])
            If pi.CanRead AndAlso pi.CanWrite Then
                selectedProps.Add(pi)
            End If
        Next
        properties = DirectCast(selectedProps.ToArray(GetType(PropertyInfo)), PropertyInfo())
        Dim propertyValues As Object() = New Object(properties.Length - 1) {}
        For i As Integer = 0 To properties.Length - 1
            Dim propInfo As PropertyInfo = properties(i)
            propertyValues(i) = propInfo.GetValue(attribute, Nothing)
        Next
        Return propertyValues
    End Function

    Private Shared Function GetFieldValues(ByVal attType As Type, ByRef fields As FieldInfo(), ByVal attribute As Attribute) As Object()
        fields = attType.GetFields(BindingFlags.[Public] Or BindingFlags.Instance)
        Dim values As Object() = New Object(fields.Length - 1) {}
        For i As Integer = 0 To fields.Length - 1
            Dim fieldInfo As FieldInfo = fields(i)
            values(i) = fieldInfo.GetValue(attribute)
        Next
        Return values
    End Function

    ''' <summary> 
    ''' Here we try to match a constructor argument to its value. 
    ''' Since we can't get the values from the assembly, we use some heuristics to get it. 
    ''' a/ we first try to match all the properties on the attributes by name (case insensitive) to the argument 
    ''' b/ if we fail we try to match them by property type, with some smarts about convertions (i,e: can use Guid for string). 
    ''' </summary> 
    Private Shared Sub InitializeConstructorArgs(ByVal attType As Type, ByVal attribute As Attribute, ByVal args As Object(), ByVal parameterInfos As ParameterInfo())
        For i As Integer = 0 To args.Length - 1
            args(i) = GetArgValue(attType, attribute, parameterInfos(i))
        Next
    End Sub

    Private Shared Function GetArgValue(ByVal attType As Type, ByVal attribute As Attribute, ByVal parameterInfo As ParameterInfo) As Object
        Dim paramType As Type = parameterInfo.ParameterType
        Dim propertyInfos As PropertyInfo() = attType.GetProperties()
        'first try to find a property with 
        For Each propertyInfo As PropertyInfo In propertyInfos
            If propertyInfo.CanRead = False AndAlso propertyInfo.GetIndexParameters().Length <> 0 Then
                Continue For
            End If

            If String.Compare(propertyInfo.Name, parameterInfo.Name, True) = 0 Then
                Return ConvertValue(propertyInfo.GetValue(attribute, Nothing), paramType)
            End If
        Next
        Dim bestMatch As PropertyInfo = Nothing
        'now we try to find it by type 
        For Each propertyInfo As PropertyInfo In propertyInfos
            If propertyInfo.CanRead = False AndAlso propertyInfo.GetIndexParameters().Length <> 0 Then
                Continue For
            End If
            bestMatch = ReplaceIfBetterMatch(parameterInfo, propertyInfo, bestMatch)
        Next
        If bestMatch IsNot Nothing Then
            Return ConvertValue(bestMatch.GetValue(attribute, Nothing), paramType)
        End If
        Return GetDefaultValueFor(paramType)
    End Function

    ''' <summary> 
    ''' We have the following rules here. 
    ''' Try to find a matching type, failing that, if the parameter is string, get the first property (under the assumption that 
    ''' we can convert it. 
    ''' </summary> 
    Private Shared Function ReplaceIfBetterMatch(ByVal parameterInfo As ParameterInfo, ByVal propertyInfo As PropertyInfo, ByVal bestMatch As PropertyInfo) As PropertyInfo
        Dim notBestMatch As Boolean = bestMatch Is Nothing OrElse Not bestMatch.PropertyType Is parameterInfo.ParameterType
        If propertyInfo.PropertyType Is parameterInfo.ParameterType AndAlso notBestMatch Then
            Return propertyInfo
        End If
        If parameterInfo.ParameterType Is GetType(String) AndAlso notBestMatch Then
            Return propertyInfo
        End If
        Return bestMatch
    End Function

    ''' <summary> 
    ''' Attributes can only accept simple types, so we return null for null, 
    ''' if the value is passed as string we call to string (should help with converting), 
    ''' otherwise, we use the value as is (enums, integer, etc). 
    ''' </summary> 
    Private Shared Function ConvertValue(ByVal obj As Object, ByVal paramType As Type) As Object
        If obj Is Nothing Then
            Return Nothing
        End If
        If paramType Is GetType(String) Then
            Return obj.ToString()
        End If
        Return obj
    End Function

    Private Shared Function GetDefaultValueFor(ByVal type As Type) As Object
        If type Is GetType(Boolean) Then
            Return False
        ElseIf type.IsEnum Then
            Return [Enum].GetValues(type).GetValue(0)
        ElseIf type Is GetType(Char) Then
            Return Char.MinValue
        ElseIf type.IsPrimitive Then
            Return 0
        End If
        Return Nothing
    End Function

End Class